Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE22/TIMING/HIRESTMR.PAS

Pascal/Delphi Source File | 1997-03-22 | 15.2 KB | 707 lines

Unit HiResTmr;

{$I LibDef.inc}

Interface


{$IFDef TargetDelphi }
 uses
  WinTypes, WinProcs;
{$ENDIF}





{ This section only valid for 16-bit targets }
{ ############################################################## }
{$IFDef Target16Bit }



  { Timer definitions }
  { -------------------------------------------------------- }


 { Compatible with 32-bit API definitions }
 type
    LONGLONG = Comp;
    PLargeInteger = ^TLargeInteger;
    TLargeInteger = record
      case Integer of
      0: (
        LowPartLowWord,
        LowPartHighWord,
        HighPartLowWord,
        HighPartHighWord : word);
      1: (
        LowPart : Longint;
        HighPart: Longint);
      2: (
        QuadPart: LONGLONG);
    end;


  procedure QueryPerformanceCounter( var AValue : TLargeInteger );
  { Returns the value of the hi perf counter }

  { End Timer definitions }
  { -------------------------------------------------------- }





  { Windows support routines }
  { -------------------------------------------------------- }

  procedure BeginCriticalSection;
  { Advises windows to suspend time-slice }
  procedure EndCriticalSection;
  { Advises windows to released suspended time-slice }
  function  bfunc_GetWindowsInstalledState : boolean;
  { Returns the state of windows installed }
  function  wfunc_GetWindowsInstalledVersion : word;
  { Returns the version of windows. Result is
    HiByte = minor version, LoByte = Major version }

  function  GetDeviceEntryPointAddress(
              ADeviceID : word ) : pointer;
  { Returns the entry point for this specified device driver }

  { End Windows support routines }
  { -------------------------------------------------------- }



{ End section only valid for 16-bit targets }
{ ############################################################## }
{$ENDIF }








{ This section valid for all targets }
{ ############################################################## }


  { Timer definitions }
  { -------------------------------------------------------- }

  { Definitions relating to the performance counter in use }
  const

  { The max value before rollover. Default is -1 but
    MSDOS timer counter rolls over each midnight and will
    reprogram this value }
  r_CounterMaxValue : TLargeInteger = ( QuadPart : -1 );


  { The resolution which defaults in DOS and Win3 to about 0.8us,
    Delphi 2 32-bit will load this value too, in case
    it changes in the future }
  r_CountsPerSec    : TLargeInteger = ( QuadPart : 1193180);


  { The number of counter counts taken to call the performance
    counter }
  r_CounterCallOverhead : TLargeInteger = ( QuadPart : 0);



  procedure DelayUS( AValue : longint );
  { Delays this value using the performance counter }

  procedure DelayMS( AValue : longint );
  { Delays this value using the performance counter }

  procedure DelayS( const AValue : extended );
  { Delays this value using the performance counter }

  { End Timer definitions }
  { -------------------------------------------------------- }



  { Windows support routines }
  { -------------------------------------------------------- }

  const
   b_WindowsInstalled : boolean = False;
   w_WindowsVersion   : word    = 0;

  { End Windows support routines }
  { -------------------------------------------------------- }

{ End section valid for all targets }
{ ############################################################## }







Implementation




{$IFDef TargetDOSMode }
 uses
  Dos;
{$ENDIF}







{ Section valid for all targets }
{ ############################################################## }

  function  GetElapsed(
               const AValue, AStart : comp ) : comp;
  { Returns the duration between AValue and AStart including any rollover }
  begin
    If AValue < AStart then
      { Has rolled over }
       GetElapsed := AValue + (r_CounterMaxValue.QuadPart - AStart)
     else
       GetElapsed := AValue - AStart;
  end;



  procedure WaitForElapsed( const AValue : TLargeInteger);
  { Hangs waiting for counter to reach this value }
  var
   R, r_Start : TLargeInteger;
  begin
   QueryPerformanceCounter( r_Start );
   Repeat
     QueryPerformanceCounter( R );
   until GetElapsed( R.QuadPart, r_Start.QuadPart ) >= AValue.QuadPart;
  end;




  procedure CalibratePerformanceCounterOverhead;
  { Calls the performance counter to determine the time overhead }
  var
   I              : word;
   r_Start, r_End : TLargeInteger;
  begin

   {$IFNDEF TargetDelphi2}
   BeginCriticalSection;
   {$ENDIF}

   QueryPerformanceCounter( r_Start );

   For I := 1 to 1000 do
     QueryPerformanceCounter( r_End );

   {$IFNDEF TargetDelphi2}
   EndCriticalSection;
   {$ENDIF}

   { Get the difference }
   r_CounterCallOverhead.QuadPart := GetElapsed( r_End.QuadPart, r_Start.QuadPart );
   r_CounterCallOverhead.QuadPart := r_CounterCallOverhead.QuadPart / 1000;
  end;




  procedure DelayUS( AValue : longint );
  { Delays this value using the performance counter }
  var
    r_Elapsed  : TLargeInteger;
  begin
    r_Elapsed.QuadPart :=
      ((AValue * r_CountsPerSec.QuadPart) * 1e-6)
     -( r_CounterCallOverhead.LowPart * 2);
    If r_Elapsed.QuadPart < 0 then
      r_Elapsed.QuadPart := 0;
    WaitForElapsed( r_Elapsed );
  end;



  procedure DelayMS( AValue : longint );
  { Delays this value using the performance counter }
  var
    r_Elapsed : TLargeInteger;
  begin
    r_Elapsed.QuadPart :=
      ((AValue * r_CountsPerSec.QuadPart) * 1e-3)
     - (r_CounterCallOverhead.QuadPart * 2);
    If r_Elapsed.QuadPart < 0 then
      r_Elapsed.QuadPart := 0;
    WaitForElapsed( r_Elapsed );
  end;


  procedure DelayS( const AValue : extended );
  { Delays this value using the performance counter }
  var
    r_Elapsed : TLargeInteger;
  begin
    r_Elapsed.QuadPart :=
       (AValue * r_CountsPerSec.QuadPart)
     - (r_CounterCallOverhead.QuadPart * 2);
    If r_Elapsed.QuadPart < 0 then
      r_Elapsed.QuadPart := 0;
    WaitForElapsed( r_Elapsed );
  end;



{ End Section valid for all targets }
{ ############################################################## }


























{ This section only valid for MSDOS targets }
{ ############################################################## }
{$IFDef TargetDOSMode }




  { MSDOS counter implementation of 'QueryPerformanceCounter' }
  { ----------------------------------------------------------}


  procedure InitializeTimerCounter;
  { Setup the timer chip to required mode
    Thanks to TurboPower inc for information in OPTIMER.PAS }
  begin
    { mode 2, read/write channel 0}
    Port[$43] := $34;        {00110100b}
    asm
      jmp @1  {delay}
    @1:
    end;
    Port[$40] := $00;        {LSB = 0}
    asm
      jmp @2  {delay}
    @2:
    end;
    Port[$40] := $00;        {MSB = 0}
  end;

  procedure RestoreTimerCounter;
  { Restore the timer chip to its normal state
    Thanks to TurboPower inc for information in OPTIMER.PAS }
  begin                      {RestoreTimer}
    {select timer mode 3, read/write channel 0}
    Port[$43] := $36;        {00110110b}
    asm
      jmp @1 {delay}
    @1:
    end;
    Port[$40] := $00;        {LSB = 0}
    asm
      jmp @2 {delay}
    @2:
    end;
    Port[$40] := $00;        {MSB = 0}
  end;


  procedure QueryMSDOSTimerCounter( Var AValue : TLargeInteger );
  { Returns the value of the hi perf counter.
    Thanks to TurboPower inc for information in OPTIMER.PAS }
  begin
    asm
      cli             {Disable interrupts}
      mov  dx,$20     {Address PIC ocw3}
      mov  al,$0A     {Ask to read irr}
      out  dx,al
      mov  al,$00     {Latch timer 0}
      out  $43,al
      in   al,dx      {Read irr}
      mov  di,ax      {Save it in DI}
      in   al,$40     {Counter --> bx}
      mov  bl,al      {LSB in BL}
      in   al,$40
      mov  bh,al      {MSB in BH}
      not  bx         {Need ascending counter}
      in   al,$21     {Read PIC imr}
      mov  si,ax      {Save it in SI}
      mov  al,$0FF    {Mask all interrupts}
      out  $21,al
      mov  ax,$40     { delay }

      mov  ax,$40     {read low word of time}
      mov  es,ax      {from BIOS data area}
      mov  dx,es:[$6C]
      mov  cx,es:[$6E]{result now as CX:DX:BX}

      mov  ax,si      {Restore imr from SI}
      out  $21,al
      sti             {Enable interrupts}
      mov  ax,di      {Retrieve old irr}
      test al,$01     {Counter hit 0?}
      jz   @done      {Jump if not}
      cmp  bx,$FF     {Counter > $FF?}
      ja   @done      {Done if so}
      add  dx,1       {Else count int req.}
      adc  cx,0       {ripple carry}


   @done:
      les di, AValue
      mov es:[di],  bx  {lsw}
      mov es:[di+2],dx
      mov es:[di+4],cx
      mov ax,0
      mov es:[di+6],ax  {msw}
  end;
  end;

  var
   SaveExitProc : pointer;


  {$F+}
  procedure OurExitProc;
  { Restore timer to its original state}
  begin
    ExitProc := SaveExitProc;
    RestoreTimerCounter;
  end;
  {$F-}

  procedure InitialiseMSDOSTimerCounter;
  { Called at start to setup timer }
  begin
    {set up our exit handler}
    SaveExitProc := ExitProc;
    ExitProc := @OurExitProc;

    {reprogram the timer chip}
    InitializeTimerCounter;

    { Set the counter max value }
    With r_CounterMaxValue do
      begin
      LowPart  := $00B0FFFF;
      HighPart := $18;
      end;
  end;


  { End MSDOS counter implementation of 'QueryPerformanceCounter' }
  { ----------------------------------------------------------}


{$ENDIF}
{ End section only valid for MSDOS targets }
{ ############################################################## }





















{ This section only valid for 16-bit targets }
{ ############################################################## }
{$IFDef Target16Bit }



  { Windows support routines }
  { ----------------------------------------------------------}

   procedure BeginCriticalSection; assembler;
   { Advises windows to suspend time-slice }
   asm
     mov     ax, 1681h   { Begin critical section      }
     int     2Fh         { multiplex interrupt         }
   end;

   procedure EndCriticalSection; assembler;
   { Advises windows to released suspended time-slice }
   asm
     mov     ax, 1682h   { End critical section        }
     int     2Fh         { multiplex interrupt         }
   end;


   function bfunc_GetWindowsInstalledState : boolean; assembler;
   { Returns the state of windows installed }
   asm
     mov     ax, 1600h   { Get Windows Installed State }
     int     2Fh         { multiplex interrupt         }
     and     al, 7Fh
     jz      @No         { Windows not running         }
     mov al, $FF
   @no:
   end;

   function wfunc_GetWindowsInstalledVersion : word; assembler;
   { Returns the version of windows. Result is
     HiByte = minor version, LoByte = Major version }
   asm
     mov     ax, 1600h   { Get Windows Installed State  }
     int     2Fh         { multiplex interrupt          }
     and     al, 7Fh
     jnz     @IsWindows  { Windows running, AX has vers }
     mov ax, 0
   @IsWindows:
   end;


   function GetDeviceEntryPointAddress(
               ADeviceID : word ) : pointer;
   { Returns the entry point for this specified device driver }
   begin
     If not b_WindowsInstalled then
       GetDeviceEntryPointAddress := nil
      else
       asm
         mov     bx, ADeviceID  { Device identifier }
         mov     ax, 1684h      { Get Device Entry Point Address }
         int     2Fh            { multiplex interrupt }
         mov word ptr @Result,    di
         mov word ptr @Result+2,  es
       end;
   end;


   { End Windows support routines }
   { -------------------------------------------------------- }













  { Windows-hosted routines for timing - 16-bit only }
  { ----------------------------------------------------------}


  function GetVTDDeviceEntryPointAddress : pointer;
  { Returns the entry point for the virtual timer device
    driver }
  begin
     GetVTDDeviceEntryPointAddress :=
        GetDeviceEntryPointAddress( 5 { VTD identifier } );
  end;


  const
   VTDAddress : pointer = nil;


  procedure QueryWindowsVTDCounter( var AValue : TLargeInteger );
  { Returns the value of the hi perf counter }
  begin
     If VTDAddress = nil then
       VTDAddress := GetVTDDeviceEntryPointAddress;
     If VTDAddress = nil then
       RunError; {No VTD installed - needs windows}
     asm
       mov ax,$100
       call VTDAddress
       db $66, $50   {push eax}
       db $58        {pop  ax}
       db $5B        {pop  bx}
       db $66, $52   {push edx}
       db $59        {pop  cx}
       db $5A        {pop  dx}
       les di, AValue
       mov es:[di+0],   ax {w0 lsw}
       mov es:[di+2],   bx {w1 }
       mov es:[di+4],   cx {w2 }
       mov es:[di+6],   dx {w3 msw}
     end;
  end;


  procedure QueryPerformanceCounter( var AValue : TLargeInteger );
  { Returns the value of the performance counter }
  begin

    {$IFDEF TargetDOSMode}
    If b_WindowsInstalled then
     QueryWindowsVTDCounter( AValue )
      else
     QueryMSDOSTimerCounter( AValue );
    {$ENDIF}

    {$IFDEF TargetDelphi1}
    QueryWindowsVTDCounter( AValue );
    {$ENDIF}

  end;

  { End windows-hosted routines for timing - 16-bit only }
  { ----------------------------------------------------------}





  { General 16-bit routines }
  { ----------------------------------------------------------}


  procedure InitialisationTasks;
  begin
    { Get details about any Windows running }
    b_WindowsInstalled := bfunc_GetWindowsInstalledState;
    w_WindowsVersion   := wfunc_GetWindowsInstalledVersion;

    {$IFDEF TargetDosMode}
    If not b_WindowsInstalled then
       InitialiseMSDOSTimerCounter;
    {$ENDIF}
    CalibratePerformanceCounterOverhead;
  end;


  { End General 16-bit routines }
  { ----------------------------------------------------------}



{$ENDIF}
{ End section only valid for 16-bit mode targets }
{ ############################################################## }







{ This section only valid for Delphi 2 32-bit target }
{ ############################################################## }
{$IFDef TargetDelphi2 }


  procedure InitialisationTasks;
  var
     OSVersionInfo: TOSVersionInfo;
   begin
     b_WindowsInstalled := True;
     OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
     if GetVersionEx(OSVersionInfo) then
      With OSVersionInfo do
        w_WindowsVersion   := (dwMinorVersion shl 8) or (dwMajorVersion and $FF)
       else
        w_WindowsVersion   := 0;

    QueryPerformanceFrequency( r_CountsPerSec );
    CalibratePerformanceCounterOverhead;
  end;







{$ENDIF}
{ End section only valid for Delphi 2 32-bit target }
{ ############################################################## }








































begin
  InitialisationTasks;
end.